perm filename STAFF.FAI[XX,LCS] blob
sn#207671 filedate 1976-03-19 generic text, type T, neo UTF8
00100 C**** BMSTF, BMS, METER, RNOTE, MAKNUM, IABS, DRWNT, RHORZ, RDRAW
00200 C ********** WHOLE & HALF RESTS, BEAMS ******
00300 SUBROUTINE BMSTF
00400 IMPLICIT INTEGER(A-Q,S-Z)
00500 REAL DIS,DISX,HGT,POS,CENTR,STFF,HGT1
00600 COMMON/STF/RSTFAC(-3/4),RSTJ2/MIN/MINI,RMINI
00700 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/BM/RA,RC,RJY
00800 COMMON/POSI/STFF(-3/4),JJ2,POS/PLTR/PLT,RHT,DIS
00900 COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
01000 1 RJA,YY,DISX,HGT,RZ,INP(53)
01100 EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3))
01200 1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
01300 1,(J11,JQ(9)),(J6,JQ(4)),(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1))
01400 1 ,(R7,RJQ(5)),(R4,RJQ(2)),(R9,RJQ(7)),(R10,RJQ(8)),(RX3,RJQ(20))
01500 DATA R14/14.54/,RTF/3.0/,RHGT/48.0/,R2HGT/96.0/,RBM/.83/
01600 C RDBR IS SPACER FOR DBL BAR.
01700 C RTF COMPENSATES FOR BAD PLANNING.
01800 RST7=RSTJ2*7.
01900 RST18=RSTJ2*18.
02000 C TO COMPENSATE FOR NOTE #3 COMING AT POS=0
02100
02200 R3Q=R3
19400 STAFF: 0 ;100 RA=0
19500 ; FOR STAFF LINES: 8, POS 1, HGT(3 TO -3), UP-DOWN(NT #S),
19600 ; P5=SIZE, P6=2ND POS., P7=(1=INVIS.), P8=SPACER, P9=INST. NAME
19700 ; P6=SIZE FACTOR, IF P7≠0 STAFF IS INVIS.
19800 ; PLT =-2 MAKES HEAVY STAFF.(FOR XGP)
19900 SETZ 15, ; RA IF(R5.EQ.0)R5=RSTFAC(J2)
19950 MOVE 2,.COMM.+6
19975 JUMPN 2,.+3
19980 MOVE 3,.COMM.+3 ; J2
19985 MOVE 2,POSI+3(3) ; TEMP. R5 IS 2
20000 SKIPN 2 ;CALL NOZERO(R5)
20005 MOVE 2,[1.0]
20100 MOVEM 2,STF+3(3) ;RSTFAC(J2)=R5
20200 MOVE 4,.COMM.+5 ;RX=(J2+3)*123-369.+AMOD(R4,100.)*7.*R5
20230 FMPR 4,[7.0]
20240 FMPR 4,2
20245 MOVE 5,3
20250 ADDI 5,3 ; J2+3
20260 MULI 5,=123
20270 SUBI 5,=369
20280 TLC 5,232000
20290 FADR 5,5
20295 FADR 5,4 ; 5 IS RX
20400 MOVEM 5,POSI+3(3) ;STFF(J2)=RX
20500 MOVE 6,[3.0] ; RTF RX=RX+RTF*R5
20550 FMPR 6,2
20575 FADR 5,6 ; 5 IS RX
20600 ; FOR RTF SEE DATA
20700 MOVE 6,5 ; 6 IS RA
20800 ; FOR 2 PASS PLOTTING
20900 RJ=RHORZ(R6)
21000 IF(R6.EQ.0)RJ=596
21100 R5=R5*14.
21200 IF(R8.EQ.0)GO TO 68
21300 IF(PLT)GO TO 68
21400 RZ=RX+R8*167.
21500 C 167 IS A MAGIC NUMBER!! PUTS LINE ON DPY.
21600 CALL LINX(R3,RZ,RJ,RZ)
21700 C SHOWS WHERE NEXT STAFF 0 WILL BE.
21800 68 IF(J7.EQ.0)GO TO 101
21900 IF(PLT.EQ.0)CALL LINES(-596.,RX,3)
22000 C TO ACTIVATE DPY BUFFER
22100 RETURN
22110 101 L=IABS(J4/100)
22120 IF(L.EQ.0)L=5
22130 C P4=0=STANDARD 5-LINE STAFF. 600=6 LINES, ETC.
22200 69 DO 6 K=1,L
22300 RZ=RJ
22400 RW=R3
22500 IF(K.EQ.2)GO TO 66
22600 IF(K.NE.4)GO TO 67
22700 66 CALL EXCH(RW,RZ)
22800 67 CALL LINX(RZ,RX,RW,RX)
22900 6 RX=RX+R5
23000 IF(RA.EQ.1000)RETURN
23100 IF(PLT.NE.-2)RETURN
23200 RX=RA-1./RHT
23400 RA=1000
23500 GO TO 69
23600 END
24200
24300 SUBROUTINE METER
24400 COMMON R2,JA,CENTR,J2,RJQ(20),J3,JQ(19)/STF/RSTFAC(-3/4),RSTJ2
24500 COMMON/POSI/STFF(-3/4),JJ2,POS
24600 EQUIVALENCE (R4,RJQ(2)),(R7,RJQ(5)),(R6,RJQ(4)),(R5,RJQ(3))
24700 1,(R8,RJQ(6)),(RX3,RJQ(20)),(J10,JQ(7)),(J7,JQ(5)),(R9,RJQ(7))
24800
24900 C PARAMS 18 / STF / POS / VERT HGT./ TOP NUM/ BOT NUM/ SIZE FAC.
25000
25100 CALL NOZERO(R7)
25200 JZ=J3
25300 RY=R4+8.*R7
25400 C HEIGHT
25500 RW=R6
25600 C BOTTOM NUM
25700 C P5=TOP NUM
25800 R6=R7
25900 RR6=R6
26000 C SIZE
26100 C FOR BDR40 -- OR =1
26200 M=0
26300 R4=RY
26400 2 R7=0
26500 C R7=0 FOR BDR FONT??
26600 CC IF(R5.NE.99)GO TO 1
26700 IF(R5.LT.90)GO TO 3
26800 C 99 AS METER = 'C' 98=ALLA BREVE (CUT TIME)
26900 M=-1
27000 IF(R5.NE.98)GO TO 4
27100 C NEXT FOR LINE THROUGH C.
27200 RZ=R6
27300 RY=R4
27400 RA=POS
27500 R6=RX3
27600 C TO LINE UP WITH R3
27700 J10=2
27800 C FOR THICK LINE
27810 CC R5=9.8+R4
27900 CC R4=R4+4.2
28000 R4=R4-3.8
28050 R5=R4+5.6
28100 J7=0
28200 R8=0
28300 CALL ITMSUB
28400 POS=RA
28500 R4=RY
28600 R6=RZ
28700 C GET BACK THE RIGHT PARAMS.
28800
28900 4 R5=9999.
29000 GO TO 3
29100 C TO CENTER 12S AND 16S
29200 3 CALL MAKNUM(R5)
29300 IF(M)RETURN
29400 C STICK AROUND FOR BOTTOM NUM
29500 M=-1
29600 R4=RY-4.*RR6
29700 R6=RR6
29800 R5=RW
29900 C GET BOTTOM NUM
30000 J3=JZ
30100 R8=0
30200 GO TO 2
30300 END
30900
31000 SUBROUTINE MAKNUM(RNUM)
31100 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/STF/RSTFAC(-3/4),RSTJ2
31200 EQUIVALENCE (J3,JQ(1)),(R4,RJQ(2)),(R8,RJQ(6)),(R7,RJQ(5))
31300 1,(R6,RJQ(4)),(R5,RJQ(3)),(R7,RJQ(5)),(JQ(15),B),(JQ(16),C)
31400 1 ,(J8,JQ(6)),(J10,JQ(8)),(R3,RJQ(1)),(J5,JQ(3)),(RJY,JQ(19))
31500 1 ,(J7,JQ(5)),(J6,JQ(4)),(R9,RJQ(7))
31600 DATA RS/10.0/,RBX/1.0/
31700 RB8=R8
31800 J3X=J3
31900 C P7=0=BDR40; =1=BDI40; =2=PRIM.
32000 CALL NOZERO(R6)
32100 R5=R6
32200 C UPPER CASE - BDR40
32300 R6=48000000.0+(R7+50.)*10000.
32400 R7=99999999.0
32500 C BLANKS
32600 R8=R7
32700 IF(RNUM.NE.9999.)GO TO 2
32800 C NEXT FOR 'C'OMMON TIME
32900 RNUM=12.
33000 C MAKES A 'C'
33100 R4=R4-2.2
33200 C .2 FOR BAD POS. OF LETTERS
33300 GO TO 4
33400
33500 2 ONE=0
33600 RNUM=IFIX(RNUM)
33700 C SO MISTAKES (i.e. 2.2) WON'T BREAK THE PROG.
33800 IF(RNUM.EQ.1.)ONE=3.
33900 IF(RNUM.GT.9.)GO TO 3
34000 C JUMP FOR 2 OR 3 DIGIT NUMBER
34100 4 R6=R6+RNUM*100.+47.
34200 C PUTS BLANK ON END (.47)
34300 GO TO 1
34400
34500 3 RJY=10.
34600 IF(RNUM.GE.100.)RJY=100.
34700 B=IFIX(RNUM/RJY)
34800 C=AMOD(RNUM,RJY)
34900 IF(RNUM.LT.100)GO TO 7
35000 D=IFIX(C/10.)
35100 C=AMOD(C,10.)
35200 IF(C.EQ.1.)ONE=ONE+3.
35300 R7=C*1000000.+999999.0
35400 C=D
35500 7 R6=R6+B*100.+C
35600 IF(B.EQ.1.)ONE=ONE+3.
35700 IF(C.EQ.1.)ONE=ONE+3.
35800 B=R5
35900 IF(RNUM.GE.100.)B=B*2
36000 J3=J3-RS*RSTJ2*B
36100 C FOR 2 DIGIT NUMBER
36200 CCC IF(RNUM.GE.20.)GO TO 6
36300 CCC IF(JA.EQ.18)GO TO 6
36400 CCC RJY=5.6
36500 CCC IF(RNUM.GT.11.)RJY=3.
36600 C ADJUSTS FOR 11, ETC.
36700 CCC J2=J2+RJY*R5*RSTJ2
36800 CC6 J3=J2
36900 1 J3=J3+ONE*R5*RSTJ2
37000 C CENTERS THE NUMBER '1'
37100 CALL ALPHA
37200 J3=J3X
37300 IF(RB8.EQ.0)RETURN
37400 C NEXT FOR CIRCLES AND BOXES AROUND NUMBERS.
37500 R3=J3-R5
37600 IF(J10.EQ.0)J10=1
37700 C USE J10 FOR EVEN THICKER BOX AND CIRC.
37800 IF(RNUM.GT.9)R3=R3+R5*RBX
37900 C TO SET CENTER
38000 IF(RB8.EQ.2)GO TO 5
38100 R4=R4+R5+.1+.05/R5
38200 C END OF ABOVE IS FOR SMALL CIRCLES.
38300 B=4.5
38400 IF(RNUM.GE.100.)B=5.5
38500 R5=R5*B
38600 JA=12
38700 J6=0
38800 J7=0
38900 J8=J10
39000 CALL CENTX
39100 CALL SLUR
39200 RETURN
39300
39400 5 JA=4
39500 B=6
39600 R9=0
39700 IF(RNUM.LT.100.)GO TO 8
39800 B=9.
39900 R9=R5*6.
40000 C MAKES RECTANGLE IF ≥100
40100 8 R4=R4+R5*.7+.1
40200 R8=R5*B
40300 J5=50
40400 CALL ITMSUB
40500 C RETURNS ORIG. HORIZ. POS.
40600 END
40700 C MAKES ONLY 1 TO 3 DIGIT NUMS NOW. EXPAND LATER.
40800